home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ahoy 1985 June
/
Ahoy_Magazine_85-06_1985_Double_L.d64
/
broken melody
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
7KB
|
257 lines
0 print"[147]":poke53280,0:poke53281,6
1 print "broken melody....":print
2 print "three voices wait for user input between phrases":print
3 print "use this routine for a series of rewards"
4 rem
5 print "plays i'm on my way (from paint your wagon by lerner & loewe)"
6 print:print" one moment please..."
10 gosub 9000:goto 100
60 for n=1 to len(md$(ph))
61 for vc=0 to ev%
62 poke gr(vc),ug%(vc):rem normal notes; don't poke ug% for legato
63 for i=0 to 1
64 poke fr(vc,i),pi%(asc(mid$(me$(ph,vc),n,1)),i)
65 next:next
66 for vc=ev% to 0 step -1:poke gr(vc),g%(vc):next
67 for i=0 to du%(val(mid$(md$(ph),n,1))):next
68 rem for vc=0 to ev%:poke gr(vc),ug%(vc):next:rem staccato notes
69 next:ph=ph+1:if ph>es% then ph=0
70 for vc=0 to ev%:poke gr(vc),ug%(vc):next:return
100 print "press shift for phrase "ph
110 print "any other key to stop"
120 if peek(203)<>64 then end
130 if peek(653)=0 then 120
140 gosub 60
190 goto 100
8997 rem
8998 rem set up sound shape
8999 rem
9000 dim md$(23),me$(23,2),mv$(23,2),g%(2),gr(2),fr(2,1),ad(2)
9001 dim du%(9),pi%(168,1),ak%(2),dy%(2),sn%(2),re%(2),wf%(2)
9007 rem
9008 rem attack--voices 0,1,2
9009 rem number from 0 to 15; lower number=sharper attack
9010 ak%(0)=0:ak%(1)=0:ak%(2)=0
9015 for i=0 to 2:ak%(i)=ak%(i)*16:next
9017 rem
9018 rem decay--voices 0,1,2
9019 rem number from 0 to 15; lower number=faster decline
9020 dy%(0)=7:dy%(1)=3:dy%(2)=3
9027 rem
9028 rem sustain--voices 0,1,2
9029 rem number from 0 to 15; lower number=softer volume during sustain
9030 sn%(0)=0:sn%(1)=0:sn%(2)=0
9035 for i=0 to 2:sn%(i)=sn%(i)*16:next
9037 rem
9038 rem release--voices 0,1,2
9039 rem number from 0 to 15; lower number=faster drop to silence at end
9040 re%(0)=0:re%(1)=3:re%(2)=5
9047 rem
9048 rem set sound addresses
9049 rem
9050 fr(0,0)=54272:fr(1,0)=54279:fr(2,0)=54286
9055 for i=0 to 2:fr(i,1)=1+fr(i,0):gr(i)=fr(i,0)+4:ad(i)=gr(i)+1:next
9057 rem
9058 rem poke adsr envelopes
9059 rem
9060 for i=0 to 2:poke ad(i),at%(i) or dy%(i)
9065 poke ad(i)+1,sn%(i) or re%(i):next
9066 rem
9067 rem set up gates
9068 rem waveforms, voices 0,1,2 (add values):
9069 rem triangle on=16; sawtooth on=32; pulse on=64 (set width!); noise on=128
9070 wf%(0)=32:wf%(1)=64:wf%(2)=64
9075 for i=0 to 2:g%(i)=1 or wf%(i):ug%(i)=g%(i)and 254:next
9077 rem
9078 rem set pulse widths
9079 rem voices 0,1,2; low byte, high byte
9080 poke gr(0)-2,200:poke gr(0)-1,3
9081 poke gr(1)-2,200:poke gr(1)-1,3
9082 poke gr(2)-2,200:poke gr(2)-1,3
9096 rem
9097 rem set up pitch array
9098 rem each note, in all its octaves
9099 rem c
9100 x%=3:gosub 9190
9101 data 12,1,24,2,48,4,97,8,195,16,135,33,15,67,30,134
9102 rem d
9103 x%=4:gosub 9190
9104 data 45,1,90,2,180,4,104,9,209,18,162,37,69,75,139,150
9105 rem e (f-flat)
9106 x%=5:gosub 9190:y%=13:gosub 9195
9107 data 81,1,163,2,71,5,143,10,31,21,62,42,125,84,250,168
9108 rem f (e-sharp)
9109 x%=6:gosub 9190:y%=19:gosub 9195
9110 data 102,1,204,2,152,5,48,11,96,22,193,44,131,89,6,179
9111 rem g
9112 x%=7:gosub 9190
9113 data 145,1,35,3,71,6,143,12,30,25,60,50,121,100,243,200
9114 rem a
9115 x%=1:gosub 9190
9116 data 195,1,134,3,12,7,24,14,49,28,99,56,199,112,143,225
9117 rem b
9118 x%=2:gosub 9190
9119 data 250,1,244,3,233,7,210,15,165,31,75,63,151,126,46,253
9120 rem d-flat (c-sharp)
9121 x%=11:gosub 9190:y%=17:gosub 9195
9122 data 28,1,56,2,112,4,225,8,195,17,134,35,12,71,24,142
9123 rem e-flat (d-sharp)
9124 x%=12:gosub 9190:y%=18:gosub 9195
9125 data 62,1,125,2,251,4,247,9,239,19,223,39,191,79,126,159
9126 rem g-flat (f-sharp)
9127 x%=14:gosub 9190:y%=20:gosub 9195
9128 data 123,1,246,2,237,5,218,11,181,23,107,47,214,94,172,189
9129 rem a-flat (g-sharp)
9130 x%=8:gosub 9190:y%=21:gosub 9195
9131 data 169,1,83,3,167,6,78,13,156,26,57,53,115,106,230,212
9132 rem b-flat (a-sharp)
9133 x%=9:gosub 9190:y%=15:gosub 9195
9134 data 221,1,187,3,119,7,239,14,223,29,190,59,124,119,248,238
9135 rem c-flat
9136 x%=10:gosub 9190
9137 data 4,1,250,1,244,3,233,7,210,15,165,31,75,63,151,126
9138 rem b-sharp
9139 x%=16:gosub 9190
9140 data 24,2,48,4,97,8,195,16,135,33,15,67,30,134,255,255
9185 goto 9200
9189 rem read pitches
9190 for i=0 to 147 step 21:read pi%(i+x%,0),pi%(i+x%,1):next:return
9194 rem identical pitches
9195 for i=0 to 147 step 21:pi%(i+y%,0)=pi%(i+x%,0):pi%(i+y%,1)=pi%(i+x%,1)
9196 next:return
9197 rem
9198 rem set up durations
9199 rem
9200 for i=0 to 9:read du%(i):next
9205 data 10,128,256,384,512,640,768,1024,1152,1280
9296 rem
9297 rem set filter and volume
9298 rem filter frequency
9299 rem low byte (0-7) x%; high byte (0-255) y%
9300 x%=0:y%=100
9305 poke 54293,x%:poke 54294,y%
9308 rem filter on?
9309 rem voice 1 on=1; 2 on=2; 3 on=4; 1&2 on=3; 2&3 on=6; all on=7
9310 x%=0
9318 rem filter resonance
9319 rem peak volume (0=low, 15=high)
9320 y%=14
9325 y%=y%*16:poke 54295,x% or y%
9328 rem select filter type
9329 rem low-pass=1;band-pass=2;high-pass=4;lo-band=3;hi-band=6;all=7
9330 x%=1
9335 x%=x%*16
9337 rem
9338 rem select overall volume
9339 rem 15=high, 0=low
9340 y%=15
9345 poke 54296,x% or y%
9496 rem
9497 rem set melodies here
9498 rem
9499 rem how many voices? (minus one)
9500 ev%=2
9508 rem
9509 rem how many phrases? (minus one)
9510 es%=8
9514 rem
9515 rem melody strings
9516 rem
9517 rem each phrase has only one du%(ph) string, no matter how many voices
9518 rem each phrase has one me$(ph,vc) & one mv$(ph,vc) string per voice
9519 rem phrase 0
9520 md$(0)="0000000000000000"
9521 me$(0,0)="fffgafg@fffgafge"
9522 mv$(0,0)="6 "
9523 me$(0,1)="ccdcgdccccdcgdcc"
9524 mv$(0,1)="4545354545453545"
9525 me$(0,2)="faeagbc[191]fadagbc[191]"
9526 mv$(0,2)="3434343434343434"
9529 rem phrase 1
9530 md$(1)="0000000000000000"
9531 me$(1,0)="fffgafgef@@@@@@@"
9532 mv$(1,0)="6 "
9533 me$(1,1)="fcecdbccfcecdaca"
9534 mv$(1,1)="45454 545454 5"
9535 me$(1,2)="faeadbc[191]faeadfcf"
9536 mv$(1,2)="3434343434343435"
9539 rem phrase 2
9540 md$(2)="0000000000000000"
9541 me$(2,0)="[191][191][191]cd[191]c@[191][191][191]cd[191]ca"
9542 mv$(2,0)="6 7 67 6 7 676"
9543 me$(2,1)="@f@fcgff@f@fcgff"
9544 mv$(2,1)=" 5 4545 4545"
9545 me$(2,2)="[191]dgdcef[177][191]dgdcef[177]"
9546 mv$(2,2)="3535353535353535"
9549 rem phrase 3
9550 md$(3)="00000000000000"
9551 me$(3,0)="[191][191][191]cd[191]ca[191]@@@@@"
9552 mv$(3,0)="6 7 676 "
9553 me$(3,1)="[191]fafgeff[191]fafgf"
9554 mv$(3,1)="45454545454545"
9555 me$(3,2)="[191]dadgcf[177][191]dadgd"
9556 mv$(3,2)="35353535353535"
9559 rem phrase 4
9560 md$(4)="0000000000000000"
9561 me$(4,0)="f[191]c@c@@@d[191]c@@@@@"
9562 mv$(4,0)="6 7 67 "
9563 me$(4,1)="fffag[191]aadgfag[191]aa"
9564 mv$(4,1)="45454545 4 54545"
9565 me$(4,2)="fdffgeaf[191]fffgeaf"
9566 mv$(4,2)="3535353534353535"
9569 rem phrase 5
9570 md$(5)="000000000000000000"
9571 me$(5,0)="cfg@g@@gafg@@@@@@@"
9572 mv$(5,0)="6 "
9573 me$(5,1)="@bgegfge@bfeccafgc"
9574 mv$(5,1)=" 4 54545 4 5453 "
9575 me$(5,2)="@aecdbecgacfc[191]afgf"
9576 mv$(5,2)=" 4 54 534343 2 1"
9579 rem phrase 6
9580 md$(6)="0000000000000000"
9581 me$(6,0)="fffgafg@fffgafge"
9582 mv$(6,0)="6 "
9583 me$(6,1)="ccdcgdccccdcgdcc"
9584 mv$(6,1)="4545354545453545"
9585 me$(6,2)="faeagbc[191]fadagbc[191]"
9586 mv$(6,2)="3434343434343434"
9589 rem phrase 7
9590 md$(7)="000000000000000"
9591 me$(7,0)="fffgafgec@@@c@@"
9592 mv$(7,0)="6 7 "
9593 me$(7,1)="fcecdbcc@a@[191]cf@"
9594 mv$(7,1)="45454 5 4 5 "
9595 me$(7,2)="faeadbc[191]ffgra[177]@"
9596 mv$(7,2)="34343434343435 "
9599 rem phrase 8
9600 md$(8)="00000000000000000"
9601 me$(8,0)="dc@c[191]afgdf@@@f@@@"
9602 mv$(8,0)="7 6 7 "
9603 me$(8,1)="[191]caca@c@cfdc[191]a@f@"
9604 mv$(8,1)="5 46 5 4 "
9605 me$(8,2)="dcfcfcac[191]f[191]agf@f@"
9606 mv$(8,2)="545354 3435 3 "
9897 rem
9898 rem convert strings to usable form
9899 rem
9900 for ph=0 to es%:for vc=0 to ev%
9905 a$=me$(ph,vc):me$(ph,vc)=""
9910 for i=1 to len(a$)
9920 x%=asc(mid$(a$,i,1))
9930 if x%<72 then x%=x%-64:if x%<0 then x%=0
9931 if x%>192and x%<200 then x%=x%-178
9932 if x%=176 then x%=8
9933 if x%=191 then x%=9
9934 if x%=188 then x%=10
9935 if x%=172 then x%=11
9936 if x%=177 then x%=12
9937 if x%=187 then x%=13
9938 if x%=165 then x%=14
9939 if x%>21 then x%=0
9950 v$=mid$(mv$(ph,vc),i,1):if v$<>" " then y%=21*val(v$)
9960 if x%<>0 then x%=x%+y%
9970 me$(ph,vc)=me$(ph,vc)+chr$(x%)
9975 next:next:next
9980 ph=0
9990 return